home *** CD-ROM | disk | FTP | other *** search
/ Mac Format 1995 June / MacFormat 25.iso / Shareware City / Developers / fortran-to-c-translator-11 / Mac F2C 1.1 / Mac F2C Libraries / libI77 Sources / due.c < prev    next >
C/C++ Source or Header  |  1995-01-28  |  2KB  |  69 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3.  
  4. #ifdef KR_headers
  5. c_due(a) cilist *a;
  6. #else
  7. c_due(cilist *a)
  8. #endif
  9. {
  10.     if(!f__init) f_init();
  11.     if(a->ciunit>=MXUNIT || a->ciunit<0)
  12.         err(a->cierr,101,"startio");
  13.     f__sequential=f__formatted=f__recpos=0;
  14.     f__external=1;
  15.     f__curunit = &f__units[a->ciunit];
  16.     f__elist=a;
  17.     if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
  18.     f__cf=f__curunit->ufd;
  19.     if(f__curunit->ufmt) err(a->cierr,102,"cdue")
  20.     if(!f__curunit->useek) err(a->cierr,104,"cdue")
  21.     if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")
  22.     (void) fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
  23.     f__curunit->uend = 0;
  24.     return(0);
  25. }
  26. #ifdef KR_headers
  27. integer s_rdue(a) cilist *a;
  28. #else
  29. integer s_rdue(cilist *a)
  30. #endif
  31. {
  32.     int n;
  33.     if(n=c_due(a)) return(n);
  34.     f__reading=1;
  35.     if(f__curunit->uwrt && f__nowreading(f__curunit))
  36.         err(a->cierr,errno,"read start");
  37.     return(0);
  38. }
  39. #ifdef KR_headers
  40. integer s_wdue(a) cilist *a;
  41. #else
  42. integer s_wdue(cilist *a)
  43. #endif
  44. {
  45.     int n;
  46.     if(n=c_due(a)) return(n);
  47.     f__reading=0;
  48.     if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
  49.         err(a->cierr,errno,"write start");
  50.     return(0);
  51. }
  52. integer e_rdue(Void)
  53. {
  54.     if(f__curunit->url==1 || f__recpos==f__curunit->url)
  55.         return(0);
  56.     (void) fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
  57.     if(ftell(f__cf)%f__curunit->url)
  58.         err(f__elist->cierr,200,"syserr");
  59.     return(0);
  60. }
  61. integer e_wdue(Void)
  62. {
  63. #ifdef ALWAYS_FLUSH
  64.     if (fflush(f__cf))
  65.         err(f__elist->cierr,errno,"write end");
  66. #endif
  67.     return(e_rdue());
  68. }
  69.